perm filename COSFLO.CH[UHF,DEK] blob sn#830866 filedate 1986-12-23 generic text, type T, neo UTF8
% Change file for DDTONE.WEB, changes to yield the Floyd-Steinberg method
% changes for DDTONE.WEB to enhance contrasts
% Change file for DDTONE.WEB, computes a "sphere"
@x
reset(bytes_in,input_name,'/B:8')
@y
@z
@x
@!new_row:array[0..nn+1] of real; {densities in row being input}
@y
@!new_row:array[0..nn+1] of real; {densities in row being input}
@!row_buf:array[0..2,0..nn+1] of real; {`actual' data before enhancement}
@z
@x
@!t:eight_bits; {byte of input}
begin new_row[0]←0.0;
if i>mm then for j←1 to nn do new_row[j]←0.0
else for j←1 to nn do
	begin read(bytes_in,t); new_row[j]←(255.5-t)/256.0;
	end;
@y
@!x,@!y,@!z:real; {coordinates of input}
begin if i=1 then
	begin for j←1 to nn do row_buf[2,j]←(1250+j*j)/1000000;
	row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
	for j←0 to nn+1 do row_buf[1,j]←row_buf[2,j];
	end;
for j←0 to nn+1 do
	begin row_buf[0,j]←row_buf[1,j]; row_buf[1,j]←row_buf[2,j];
	end;
if i<mm then
	begin for j←1 to nn do
		begin x←(i-119)/111.5; y←(j-120)/111.5; z←1.0-x*x-y*y;
		if z<0.0 then row_buf[2,j]←(1250*(i+1)+j*j)/1000000
		else row_buf[2,j]←(9+x-4*y-8*sqrt(z))/18.0;
		end;
	row_buf[2,0]←row_buf[2,1]; row_buf[2,nn+1]←row_buf[2,nn];
	end;
new_row[0]←0.0;
for j←1 to nn do new_row[j]←9*row_buf[1,j]-row_buf[0,j-1]-row_buf[0,j]
 -row_buf[0,j+1]-row_buf[1,j-1]-row_buf[1,j+1]-row_buf[2,j-1]
 -row_buf[2,j]-row_buf[2,j+1];
@z
@x
@<Choose pixel values and diffuse the errors in the buffer@>=
for k←0 to 63 do
	begin i←class_row[k]; j←class_col[k];
	while j≤nn do
		begin @<Decide the color of pixel |[i,j]| and the resulting |err|@>;
		for l←start[k] to start[k+1]-1 do
			begin u←i+del_i[l]; v←j+del_j[l];
			buffer[u,v]←buffer[u,v]+err*alpha[l];
			end;
		j←j+8;
		end;
	end
@y
@<Choose pixel values and diffuse the errors in the buffer@>=
for i←1 to 8 do for j←1 to nn do
	begin @<Decide the color of pixel |[i,j]| and the resulting |err|@>;
	buffer[i,j+1]←buffer[i,j+1]+err*alpha_e;
	buffer[i+1,j-1]←buffer[i+1,j-1]+err*alpha_sw;
	buffer[i+1,j]←buffer[i+1,j]+err*alpha_s;
	buffer[i+1,j+1]←buffer[i+1,j+1]+err*alpha_se;
	end
@ @<Const...@>=
alpha_sw=0.1875; {3/16}
alpha_s=0.3125; {5/16}
alpha_se=0.0625; {1/16}
alpha_e=0.4375; {7/16}
@z
%alpha_sw=0.166666667; {3/18}
%alpha_s=0.277777778; {5/18}
%alpha_se=0.055555556; {1/18}
%alpha_e=0.388888889; {7/18}